home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / MATH / VLN_20 / ARITHM2.INC next >
Text File  |  1995-03-30  |  19KB  |  777 lines
  1. {))))))))))))))))))))))))))))))))}
  2. {}  procedure tVryLrgNo.BigSHL  {}(cnt  : integer);
  3. {))))))))))))))))))))))))))))))))}
  4.   var i: integer;
  5.   begin
  6.   if cnt+count>max then
  7.     begin
  8.   messagebox(0,'Shift Left too far', ' Arithmetic Error', 0 );
  9.     exit;
  10.     end;
  11.   for i := count  downto 1 do
  12.      tVLN[i+cnt]:= tVLN[i];
  13.   for i := 1 to cnt do
  14.      tVLN[i] := 0;
  15.   count := count + cnt;
  16.   end;
  17.  
  18. {))))))))))))))))))))))))))))))))))}
  19. {}  procedure tVryLrgNo.MultiSHL  {}(sf_cnt : integer);
  20. {))))))))))))))))))))))))))))))))))} {shift data left n bits}
  21.   var
  22.     i, BigCnt  : integer;
  23.     new,
  24.     wLeft, wRight : word;
  25.   begin
  26.    if (count = 0) or (sf_cnt=0) then exit;
  27.    BigCnt := sf_cnt shr 4;
  28.    sf_cnt := sf_cnt and $F;
  29.    new := 0;
  30.  
  31.    for i := count downto 1 do
  32.      begin
  33.       wLeft  := (tVLN[i] shl sf_cnt) ;
  34.       wRight :=  tVLN[i] shr (16-sf_cnt);
  35.       tVLN[i+1] := new or wRight;   { combine them  }
  36.       new := wLeft;
  37.      end;
  38.    inc(count); Recount;
  39.  
  40.    if max<count then
  41.       begin
  42.        callError('shl too big error');
  43.        exit;
  44.       end;
  45.  
  46.     tVLN[1]:= new;    {lowest term }
  47.  
  48.    if BigCnt>0 then
  49.      BigShl(BigCnt);
  50.  
  51.    end;
  52. {)))))))))))))))))))))))))))))))))))))}
  53. {}   procedure  tVryLrgNo.Shr1Bit;   {}
  54. {)))))))))))))))))))))))))))))))))))))}
  55.  var i : integer;
  56.  begin
  57.  if count=0 then exit;  {not an error }
  58.    for i := 1 to count-1 do
  59.      begin
  60.       tVLN[i] := tVLN[i] shr 1;
  61.       if odd(tVLN[i+1]) then inc(tVLN[i],$8000);
  62.      end;
  63.    tVLN[count] := tVLN[count] shr 1;
  64.  end;
  65.  
  66. {)))))))))))))))))))))))))))))))))))))}
  67. {}   procedure  tVryLrgNo.ShL1Bit;   {}
  68. {)))))))))))))))))))))))))))))))))))))}
  69.  var i : integer;
  70.      tmp : boolean;
  71.  begin
  72.    tmp := (tVLN[count] and $8000 <> 0);
  73.  
  74.    for i :=  count downto 1 do
  75.      begin
  76.       if (tVLN[i] and $8000 <> 0) then
  77.          inc(tVLN[i+1]);
  78.       tVLN[i] := tVLN[i] shl 1;
  79.      end;
  80.        if tmp then
  81.         begin
  82.          inc(count);
  83.          tVLN[count]:= 1;
  84.         end;
  85.    if max<count then
  86.       begin
  87.        callError('shl too big error');
  88.        exit;
  89.       end;
  90.  end;
  91.  
  92. {)))))))))))))))))))))))))))))))))))))}
  93. {}  function tVryLrgNo.FindDivShift  {} (other : pVryLrgNo) : integer;
  94. {)))))))))))))))))))))))))))))))))))))}
  95.   var
  96.     n : integer;
  97.     wo, ws : longint;
  98.   begin
  99.    {compare MS Word of each }
  100.    {Shl til bigger then shr til smaller}
  101.    wo := other^.tVLN[other^.count];
  102.    ws := tVLN[count];
  103.    n := 0;
  104.  
  105.    while (wo>ws) do  { avoid overflow }
  106.      begin
  107.       ws := ws shl 1;
  108.       inc(n);
  109.      end;
  110.  
  111.    while wo<=ws do        {make ws slightly smaller }
  112.      begin
  113.       ws := ws shr 1;
  114.       dec(n);
  115.      end;
  116.    FindDivShift := n+1;
  117.  end;
  118.  
  119.  
  120. {))))))))))))))))))))))))))))))))))))}
  121. {}  function tVryLrgNo.FindnoBinDig {}   : integer;
  122. {))))))))))))))))))))))))))))))))))))}
  123.                              { how many binary digits }
  124. var
  125.   tmpc : integer;
  126.   tmpw : word;
  127. begin
  128.   Recount;  { possibly remove zero words from the top }
  129.   tmpw := tVLN[count];
  130.   tmpc := 0;
  131.   while tmpw > 0 do
  132.     begin
  133.     tmpw := tmpw shr 1;
  134.     inc(tmpc);
  135.     end;
  136.   FindnoBinDig := tmpc + (count-1) * 16;
  137. end;
  138.  
  139. {)))))))))))))))))))))))))))))))))}
  140. {}  procedure tVryLrgNo.Copy     {} ( other : pVryLrgNo );
  141. {)))))))))))))))))))))))))))))))))}
  142.  
  143.  { copy other into self       }
  144.  
  145.  var i : integer;
  146.   begin
  147.     if max<other^.count then
  148.       begin
  149.        callError('copy too big error');
  150.        exit;
  151.       end;
  152.     count := other^.count;
  153.     sign  := other^.sign;
  154.     for i := 1 to count do
  155.        tVLN[i] := other^.tVLN[i];
  156.  
  157.   end;
  158.  
  159.  {))))))))))))))))))))))))))))))))))))))}
  160.  {}  procedure tVryLrgNo.TwosComplAbs  {}( cnt : integer );
  161.  {))))))))))))))))))))))))))))))))))))))}
  162.  var
  163.     StillZero : boolean;
  164.     i : integer;
  165.  begin
  166.    StillZero := true;
  167.    for i := 1 to cnt do
  168.      if StillZero then
  169.        begin
  170.         if tVLN[i] <>  0 then begin
  171.            tVLN[i] := - tVLN[i];
  172.            StillZero := false;
  173.            end;
  174.        end
  175.        else tVLN[i] := (- tVLN[i] -1);
  176.  end;
  177.  
  178.  
  179.  {)))))))))))))))))))))))))}
  180.  {}    function IsEqAbs   {}(n1, n2  : pVryLrgNo): boolean;
  181.  {)))))))))))))))))))))))))}
  182.   var
  183.     i , j , k : integer;
  184.     IGA : boolean;
  185.   begin
  186.     IsEqAbs := true;    {assume true}
  187.     n1^.Recount; n2^.Recount;
  188.     if n1^.count <> n2^.count then
  189.       begin
  190.         IsEqAbs := false;
  191.         exit;
  192.       end;
  193.     for i := n1^.count downto 1 do;
  194.        if n1^.tVLN[i] <> n2^.tVLN[i] then
  195.           begin
  196.             IsEqAbs := false;
  197.             exit;
  198.           end;
  199.   end;
  200.  
  201.  {)))))))))))))))))))))))))))}
  202.  {}    function IsGrEqAbs   {}(n1, n2  : pVryLrgNo): boolean;
  203.  {)))))))))))))))))))))))))))}
  204.  
  205.   { is n1 >= n2 ,ignore sign, assume both positive}
  206.   var
  207.     k : integer;
  208.     IGA : boolean;
  209.   begin
  210.     n1^.Recount; n2^.Recount;
  211.     IsGrEqAbs := not (n1^.count < n2^.count);  { first apprx. }
  212.  
  213.     if n1^.count = n2^.count  then    {almost the same }
  214.           { same number of terms}
  215.         for k := n1^.count  downto 1 do
  216.            begin
  217.             if (n1^.tVLN[k] < n2^.tVLN[k]) then
  218.                begin
  219.                 IsGrEqAbs := false;
  220.                 break;
  221.                end;
  222.             if (n1^.tVLN[k] > n2^.tVLN[k]) then
  223.                break;
  224.            end;
  225.   end;
  226.  
  227.  {)))))))))))))))))))))))))))))))}
  228.  {}   procedure AddWordArrays   {}( t1, t2 : pWordArray;
  229.  {)))))))))))))))))))))))))))))))}
  230.                  var c1, c2 : integer);  { t2 + t1 --> t2 }
  231.                  {input word arrays and counts }
  232.  var
  233.     i , carry, realcount,
  234.     msbs_pre : integer;
  235. begin
  236.    carry := 0;
  237.    realcount := MaxOfW(c1,c2);
  238.  
  239.    for i := c1 +1 to realcount do
  240.        t1^[i] := 0;  {we want to add all terms, clear higher }
  241.    for i := c2 +1 to realcount do
  242.        t2^[i] := 0;
  243.  
  244.  
  245.    if c1 > 0 then   { at least adder > 0 }
  246.          for i := 1 to realcount do begin
  247.            msbs_pre := (t1^[i] and $8000 ) shr 1
  248.                + (t2^[i] and $8000 );
  249.            t2^[i] := t2^[i] + t1^[i] + carry;
  250.  
  251.          case msbs_pre shr 1 of
  252.              $6000 : carry := 1;
  253.              0     : carry := 0;
  254.              else if (t2^[i] and $8000 = 0) then
  255.                  carry := 1
  256.                  else carry := 0;
  257.              end;
  258.          end;
  259.   c2 := realcount;
  260.   if carry<>0 then begin {after all ordinary terms added}
  261.     i := realcount +1;
  262.     t2^[i] := 1;
  263.     c2 := i;
  264.     end;
  265.  end;
  266.  
  267.  
  268.  
  269.  
  270. {(((((((((((((((((((((((((((((((}
  271. {}    procedure AddAbsolute    {}  (n2, n1  : pVryLrgNo);
  272. {(((((((((((((((((((((((((((((((}
  273.  
  274.     { n1+n2 --> n2}
  275.     {ignore sign, assume both positive}
  276.   var
  277.     i ,ovfl_det,  carry, realcount : integer;
  278.  begin
  279.    carry := 0;
  280.    realcount := MaxOfW(n1^.count,n2^.count);
  281.  
  282.    for i := n1^.count +1 to realcount do
  283.        n1^.tVLN[i] := 0;  {we want to add all terms }
  284.    for i := n2^.count +1 to realcount do
  285.        n2^.tVLN[i] := 0;
  286.  
  287.  
  288.    if n1^.count > 0 then   { at least adder > 0 }
  289.          for i := 1 to realcount do begin
  290.            ovfl_det := (n2^.tVLN[i] and $8000 ) shr 1
  291.                     + (n1^.tVLN[i] and $8000 );
  292.            n2^.tVLN[i] := n2^.tVLN[i] + n1^.tVLN[i] + carry;
  293.  
  294.            case ovfl_det shr 1 of
  295.               0     : carry := 0;
  296.               $6000 : carry := 1
  297.               else
  298.                 if (n2^.tVLN[i] and $8000 = 0) then
  299.                    carry := 1
  300.                 else carry := 0;
  301.               end
  302.          end;
  303.   n2^.count := realcount;
  304.  
  305.   if carry<>0 then begin {after all ordinary terms added}
  306.     i := realcount +1;
  307.     n2^.tVLN[i] := 1;
  308.     n2^.count := i;
  309.     end;
  310.  
  311.   if n2^.count>n2^.max then
  312.       begin
  313.        callError('Add Abs too big error');
  314.        exit;
  315.       end;
  316.  end;
  317.  
  318.  
  319. {(((((((((((((((((((((((((((((((}
  320. {}    procedure SubAbsolute    {}  (n2, n1  : pVryLrgNo);
  321. {(((((((((((((((((((((((((((((((}
  322.  
  323.     { n2-n1 --> n2}
  324.     {ignore sign, assume both positive, n2>=n1}
  325.     { assume n2 >= n1 >= 0}
  326.   var
  327.     i , borrow, realcount,
  328.      ovfl_det : integer;
  329.  begin
  330.    borrow := 0;
  331.    realcount := MaxOfW(n1^.count,n2^.count);
  332.  
  333.    for i := n1^.count +1 to realcount do
  334.        n1^.tVLN[i] := 0;  {we want to sub all terms }
  335.    for i := n2^.count +1 to realcount do
  336.        n2^.tVLN[i] := 0;
  337.  
  338.  
  339.    if n1^.count > 0 then   { if something in subt' }
  340.          for i := 1 to realcount do begin
  341.            ovfl_det := (n1^.tVLN[i] and $8000 ) shr 1
  342.                     + (n2^.tVLN[i] and $8000 );
  343.            n2^.tVLN[i] := n2^.tVLN[i] - n1^.tVLN[i] - borrow;
  344.  
  345.            case ovfl_det shr 1 of
  346.               $4000 : borrow := 0;
  347.               $2000 : borrow := 1
  348.               else
  349.                 if (n2^.tVLN[i] and $8000 = 0) then
  350.                    borrow := 0
  351.                 else borrow := 1;
  352.               end
  353.          end;
  354.  
  355.    n2^.recount;
  356.    if n2^.count>n2^.max then
  357.       begin
  358.        callError('Sub Abs too big error');
  359.        exit;
  360.       end;
  361.  
  362.  end;
  363.  
  364.  {(((((((((((((((((((((((((((((((}
  365.  {}  procedure tVryLrgNo.addBy  {}(other : pVryLrgNo);
  366.  {(((((((((((((((((((((((((((((((}
  367.  var  i : integer;
  368.  begin
  369.    if  ((sign +other^.sign) <> 0) then
  370.      { does second term reinforce first term}
  371.       AddAbsolute( @self, other)  { me := me + other }
  372.    else if IsGrEqAbs(@self, other) then begin
  373.      { does first term dominate }
  374.         SubAbsolute( @self, other);
  375.         Recount;
  376.         end
  377.    else begin
  378.      SubAbsolute( @self, other);
  379.      TwosComplAbs(other^.count);  {how many terms neeeded}
  380.      sign := - sign;
  381.      Recount;
  382.      end;
  383.  end;
  384.  
  385.  {(((((((((((((((((((((((((((((((}
  386.  {}  procedure tVryLrgNo.subBy  {} (other : pVryLrgNo);
  387.  {(((((((((((((((((((((((((((((((}
  388.  var  i : integer;
  389.  begin
  390.    if  ((sign +other^.sign) = 0) then
  391.      { does second term reinforce first term}
  392.       AddAbsolute( @self, other)  { me := me - other }
  393.    else if IsGrEqAbs(@self, other) then  begin
  394.      { does first term dominate }
  395.        SubAbsolute( @self, other);
  396.        Recount;
  397.        end
  398.    else begin
  399.      SubAbsolute( @self, other);
  400.      TwosComplAbs(other^.count);  {how many terms neeeded}
  401.      sign := - sign;
  402.      Recount;
  403.      end;
  404.  end;
  405.  
  406.  
  407. {(((((((((((((((((((((((((((((((}
  408. {}  procedure tVryLrgNo.mulBy  {}(other : pVryLrgNo);
  409. {(((((((((((((((((((((((((((((((}
  410.  var
  411.      long1, long2 : longint;
  412.      tempAccum  : longint;
  413.      i1, i2,
  414.      c0, s0 : integer;
  415.      shifter, ovfl_det : integer;
  416.      answer_sign : integer;
  417.  
  418.  begin
  419.    answer_sign := sign * other^.sign;
  420. {    sign := 1;
  421.     other^.sign := 1;
  422.  }
  423.    for i1 := 1 to wksize do
  424.      begin
  425.      vlnVars[91]^.tVLN[i1] := 0;
  426.      vlnVars[96]^.tVLN[i1] := 0;
  427.      end; { clear acumulators}
  428.  
  429.    if (count + other^.count > max )  then
  430.      begin
  431.   messagebox(0,'multiply too big', ' Arithmetic Error', 0 );
  432.  
  433.      exit;
  434.      end;
  435.  
  436.    for i1 := 1 to other^.count do
  437.        {this 'other' term by each of the self terms}
  438.        for i2 := 1 to count do begin
  439.           long1 := longint(tVLN[i2]) *
  440.                    longint(other^.tVLN[i1]);
  441.  
  442.           shifter := i1+i2 ;     { pick destination position }
  443.           tempAccum := vlnVars[91]^.tVLN[shifter];
  444.  
  445.           ovfl_det := ((tempAccum and $8000 ) shr 15)
  446.                + ((long1 shr 16) and $8000 ) shr 14;
  447.           tempAccum := tempAccum shl 16 +
  448.                  vlnVars[91]^.tVLN[shifter-1] ;
  449.  
  450.           inc(tempAccum, long1);    { add in this terms}
  451.  
  452.           vlnVars[91]^.tVLN[shifter-1] :=  tempAccum and $FFFF;
  453.           vlnVars[91]^.tVLN[shifter]   :=  (tempAccum shr 16) and $FFFF;
  454.  
  455.     if (ovfl_det = 3)  or
  456.                  ( (ovfl_det<>0) and
  457.                  (tempAccum and $80000000 = 0))
  458.       then
  459.          inc(vlnVars[96]^.tVLN[shifter+1]);
  460.  
  461.    end;
  462.    count := count + other^.count;
  463.    c0 := count;
  464.    sign := answer_sign;
  465.  
  466.    AddWordArrays( @vlnVars[96]^.tVLN[1],
  467.                   @vlnVars[91]^.tVLN[1], c0, count );
  468.    SetVal( count, sign, @vlnVars[91]^.tVLN[1]);
  469.              { put answer away }
  470.    Recount;
  471.  
  472.  end;
  473.  
  474.  
  475. {(((((((((((((((((((((((((((((((}
  476. {}  procedure tVryLrgNo.divBy  {} ( dvsr,
  477. {(((((((((((((((((((((((((((((((}   remnd : pVryLrgNo);
  478.  
  479.   var i,    SAdj,
  480.       BShf, emptyBits,
  481.       sizeOfQ : integer;
  482.       dcnt : integer;
  483.       answer_sign : integer;
  484.  
  485.  begin
  486.     vlnVars[94]^.copy(dvsr);
  487.     answer_sign := sign * dvsr^.sign;
  488.     sign := 1;
  489.     vlnVars[94]^.sign := 1;       { work with positive values }
  490.  
  491.     dcnt := vlnVars[94]^.count;
  492.     vlnVars[97]^.Clear(Count);
  493.     remnd^.clear(Count);
  494.     BShf := count - dcnt;
  495.  
  496.     if (BShf<0 ) or
  497.          ((BShf=0) and
  498.                (dvsr^.tVLN[dcnt]>=tVLN[dcnt])  ) then
  499.           begin                {divisor >= dividend }
  500.             remnd^.copy(@self);
  501.             remnd^.recount;
  502.             Count := 0;
  503.             exit;
  504.             end;
  505.  
  506.     SAdj :=  vlnVars[94]^.FindDivShift(@self);   {returns -15 to +15}
  507.             {number of bits to shift divisor}
  508.     if SAdj<0 then
  509.       begin
  510.       SAdj := 16 + SAdj;
  511.       dec(BShf);    { dvsr starts  smaller then dividend }
  512.       end;
  513.  
  514.     vlnVars[94]^.BigShl(BShf);    {shift divisor into position}
  515.     vlnVars[94]^.MultiSHL(SAdj);
  516.  
  517.     emptybits := BShf * 16 + SAdj;
  518.         {zeros at bottom of divisor}
  519.     sizeOfQ := 0;
  520.     vlnVars[94]^.Recount;
  521.  
  522.     while emptybits >= 0 do
  523.       begin
  524.        vlnVars[97]^.ShL1Bit;
  525.        while IsGrEqAbs(@self,vlnVars[94]) do
  526.            { make sure that we have to shift}
  527.          begin  {subtract again }
  528.           subBy(vlnVars[94]);
  529.           inc(vlnVars[97]^.tVLN[1],1); {put a bit into the answer }
  530.          end;
  531.        vlnVars[97]^.count := (sizeOfQ+16) div 16;
  532.        dec(emptybits);
  533.        if emptybits>=0 then
  534.           vlnVars[94]^.Shr1Bit;
  535.        vlnVars[94]^.Recount;
  536.        inc(sizeOfQ);
  537.       end;
  538.  
  539.       Recount;
  540.       remnd^.copy(@self);
  541.       vlnVars[97]^.sign := answer_sign;
  542.       remnd^.sign := answer_sign;
  543.       vlnVars[97]^.Recount;
  544.       copy(vlnVars[97]);
  545. end;
  546.  
  547.  
  548.  
  549. {((((((((((((((((((((((((((((((((}
  550. {}  function FastDiv   {} ( dvnd , dvsr  : integer ) : integer;
  551. {(((((((((((((((((((((((((((((((}
  552.  
  553.  var BitsN, BitsD, BitsQ,
  554.      BitsDiff : integer;
  555.      CntN, CntD  : integer;
  556.      TopN, TopD : longint;
  557. begin
  558.     BitsN := GetBinSize(dvnd);
  559.     BitsD := GetBinSize(dvsr);
  560.     BitsDiff := BitsN-BitsD;
  561.  
  562.     if (BitsDiff  < 0  ) then FastDiv := 0
  563.       else if BitsDiff > 13 then FastDiv := - BitsDiff
  564.       else  { range is such that we can get integer divisor }
  565.         begin
  566.            CntN := vlnVars[dvnd]^.count;
  567.            CntD := vlnVars[dvsr]^.count;
  568.  
  569.            TopN := vlnVars[dvnd]^.tvln[CntN];
  570.            if CntN = CntD then
  571.               TopD := vlnVars[dvsr]^.tvln[CntD]
  572.               else    TopD := 0;
  573.  
  574. { normalize using top 8-15 bits as integers }
  575. { we know that TopD has equal or fewer sig bits }
  576.           { we need several signif bits }
  577.                  if cntN > 1 then
  578.                    begin
  579.                      TopN := TopN shl 15
  580.                            + vlnVars[dvnd]^.tvln[CntN-1] shr 1;
  581.  
  582.                      TopD := TopD shl 15
  583.                            + vlnVars[dvsr]^.tvln[CntN-1] shr 1;
  584.  
  585.                     end;
  586.  
  587.            FastDiv := TopN div TopD;
  588.         end;
  589.  
  590. end;
  591.  
  592.  
  593.  
  594. {((((((((((((((((((((((((((((((((}
  595. {}  procedure tVryLrgNo.MulN   {} (n:integer );
  596. {((((((((((((((((((((((((((((((((}
  597.  
  598. begin
  599.     vlnVars[91]^.SetSmall(n);
  600.     MulBy(vlnVars[91]);
  601. end;
  602.  
  603.  
  604.  
  605. {((((((((((((((((((((((((((((((((}
  606. {}  procedure tVryLrgNo.AddN    {} (n:integer );
  607. {((((((((((((((((((((((((((((((((}
  608. begin
  609.     vlnVars[91]^.SetSmall(n);
  610.     AddBy(vlnVars[91]);
  611. end;
  612.  
  613. {((((((((((((((((((((((((((((((((}
  614. {}  procedure tVryLrgNo.SubN    {} (n:integer );
  615. {((((((((((((((((((((((((((((((((}
  616. begin
  617.     vlnVars[91]^.SetSmall(n);
  618.     SubBy(vlnVars[91]);
  619. end;
  620.  
  621.  
  622.  
  623. {((((((((((((((((((((((((((((((((}
  624. {}  procedure tVryLrgNo.DivN    {} (n:integer );
  625. {((((((((((((((((((((((((((((((((}
  626. begin
  627.     vlnVars[91]^.SetSmall(n);
  628.     DivBy(vlnVars[91], vlnVars[90]);
  629. end;
  630.  
  631.  
  632. {((((((((((((((((((((((((((((((((}
  633. {}  procedure tVryLrgNo.TwoNth  {} (n:integer );
  634. {((((((((((((((((((((((((((((((((}
  635. var
  636.  i : integer;
  637. begin
  638.  sign := 1;
  639.  
  640.   if n<= 0 then
  641.      begin
  642.        SetSmall(1);
  643.        exit;
  644.      end;
  645.  
  646.  count := n shr 4 +1;
  647.  n := n mod 16;      {up to 15 additional bits}
  648.  if count > max then
  649.     begin
  650.   messagebox(0,'Two Nth too big', ' Arithmetic Error', 0 );
  651.  
  652.      exit;
  653.     end;
  654.   for i := 1 to count-1 do
  655.      tvln[i] := 0;
  656.   tvln[count] := 1 shl n;
  657.   sign := 1;
  658. end;
  659.  
  660. {((((((((((((((((((((((((((((((((}
  661. {}  procedure tVryLrgNo.TenNth  {} (n:integer );
  662. {((((((((((((((((((((((((((((((((}
  663. var
  664.  i : integer;
  665. begin
  666.   sign := 1;
  667.   SetSmall(10);  { + 10 }
  668.   if n<= 0 then
  669.      SetSmall(1)
  670.   else
  671.      begin
  672.         if n>1 then  NthPower(n);
  673.      end;
  674. end;
  675.  
  676. {((((((((((((((((((((((((((((((((((}
  677. {}  procedure tVryLrgNo.NthPower  {}(n:integer );
  678. {((((((((((((((((((((((((((((((((((}
  679. var
  680.  i : integer;
  681. begin
  682.  vlnVars[90]^.Copy(@self);
  683.  for i := 1 to n-1 do
  684.    MulBy(vlnVars[90]);
  685. end;
  686.  
  687. {((((((((((((((((((((((((((((((((((}
  688. {}  procedure tVryLrgNo.FastNthPower  {}(n:integer );
  689. {((((((((((((((((((((((((((((((((((}   { may use registers 50-62 }
  690.  
  691.    procedure SetMultipliers;
  692.      var base, a : integer;
  693.      begin
  694.        base := 90;
  695.        vlnVars[base]^.Copy(@self);
  696.        vlnVars[base]^.MulBy(@self);{ this is squared power}
  697.  
  698.        a := n ;
  699.        while a > 1 do
  700.           begin
  701.            vlnVars[base-1]^.Copy(vlnVars[base]); { higher power by 2}
  702.            vlnVars[base-1]^.MulBy(vlnVars[base]);
  703.            dec(base);
  704.            a := a shr 1;
  705.          end;
  706.      end;
  707. {- - - - - - - - - - - local subs  - - - - - - -   }
  708. var
  709.  base : integer;
  710. begin
  711.  if (n <= 0) or  (n>=2048) then exit;
  712.  
  713.  SetMultipliers;
  714. base := 91;
  715.  
  716. if not odd(n) then
  717.    begin
  718.      while not odd(n)  do
  719.        begin
  720.          n := n shr 1;
  721.          dec(base);
  722.        end;
  723.      self.Copy(vlnVars[base]);   { first term found }
  724.    end;
  725.  
  726. while n > 1 do begin
  727.      n := n shr 1;
  728.      dec(base);
  729.      if odd(n) then
  730.        self.MulBy(vlnVars[base]);
  731.    end;
  732. end;
  733.  
  734.  
  735.  
  736. {(((((((((((((((((((((((((((((((((}
  737. {}  procedure tVryLrgNo.NthRoot  {} (n:integer );
  738. {(((((((((((((((((((((((((((((((((}
  739.  
  740. var i,j,rcnt : integer;
  741. sg,  MLimit: integer;
  742. IsDone, DeltaZero : boolean;
  743.  
  744.  
  745. { Binary Search }
  746. begin
  747.  
  748.      rcnt := FindnoBinDig div n + 1;
  749.      vlnVars[94]^.TwoNth(rcnt-1); { running bit inserter }
  750.      vlnVars[97]^.SetSmall(0) ; {clear answer }
  751.  
  752. while rcnt >= 0 do
  753.  begin
  754.  
  755.      vlnVars[97]^.AddBy(vlnVars[94]); {establish next guess}
  756.  
  757.      vlnVars[98]^.Copy(vlnVars[97]);  { a copy of the guess }
  758.  
  759.      if n > 3 then
  760.            vlnVars[98]^.FastNthPower(n)
  761.      else  vlnVars[98]^.NthPower(n);
  762.  
  763.         { Guess^Nth power  }
  764.  
  765.      if not IsGrEqAbs ( @self , vlnVars[98] ) then     {too big ??}
  766.         vlnVars[97]^.SubBy(vlnVars[94]); {take away latest}
  767.  
  768.      dec(rcnt);
  769.      vlnVars[94]^.TwoNth(rcnt); { running bit inserter }
  770.  
  771. end; { while }
  772.  
  773.  Copy(vlnVars[97]);               { return answer   }
  774. end;
  775.  
  776.  
  777.